use 5.010;
use strict;
use warnings;

=head1 NAME

JasPerl::JSTL::Functions - JSTL function tag library

=head1 SYNOPSIS

=head1 DESCRIPTION

=cut

package JasPerl::JSTL::Functions;
use parent qw(JasPerl::TagExt::TagLibrary);

use JasPerl::Exceptions;
use JasPerl::Util::Boolean qw(TRUE FALSE);
use JasPerl::Util::Number;

my $ZERO = JasPerl::Util::Number->new(0);
my $NPOS = JasPerl::Util::Number->new(-1);

our $URI = 'http://java.sun.com/jsp/jstl/functions';

my %LENGTH = (
    ''      => sub { CORE::length($_[0]) },
    'ARRAY' => sub { scalar @{$_[0]} },
    'HASH'  => sub { scalar keys %{$_[0]} }
);

=head1 FUNCTIONS

=over 4

=item contains( $str, $substr )

Tests if a string contains the specified substring.

=cut

sub contains {
    my ($class, $string, $substring) = @_;
    return TRUE unless CORE::length($substring);
    return FALSE unless CORE::length($string);
    return CORE::index($string, $substring) >= 0 ? TRUE : FALSE;
}

=item contains_ignore_case( $string, $substring )

Tests if a string contains the specified substring in a case
insensitive way.

=cut

sub contains_ignore_case {
    my ($class, $string, $substring) = @_;
    return TRUE unless CORE::length($substring);
    return FALSE unless CORE::length($string);
    return CORE::index(uc $string, uc $substring) >= 0 ? TRUE : FALSE;
}

=item ends_with( $str, $suffix )

Tests if a string ends with the specified suffix.

=cut

sub ends_with {
    my ($class, $string, $suffix) = @_;
    my $strlen = CORE::length($suffix) or return TRUE;
    my $suflen = CORE::length($string) or return FALSE;

    my $index = CORE::rindex($string, $suffix);
    return FALSE if $index < 0;
    return $index + $suflen == $strlen ? TRUE : FALSE;
}

=item escape_xml( $str )

Escapes characters that could be interpreted as XML markup.

=cut

sub escape_xml {
    my ($class, $string) = @_;
    return '' unless CORE::length($string);
    $string =~ s/&/&amp;/g;
    $string =~ s/</&lt;/g;
    $string =~ s/>/&gt;/g;
    $string =~ s/"/&#034;/g;
    $string =~ s/'/&#039;/g;
    return $string;
}

=item index_of( $str, $substr )

Returns the index within a string of the first occurrence of a
specified substring.

=cut

sub index_of {
    my ($class, $string, $substring) = @_;
    return $ZERO unless CORE::length($substring);
    return $NPOS unless CORE::length($string);

    my $index = CORE::index($string, $substring);
    return JasPerl::Util::Number->new($index);
}

=item join( $array, $separator )

Joins all elements of an array into a string.

=cut

sub join {
    my ($class, $array, $separator) = @_;
    return '' unless defined $array;

    if (ref($array) eq 'ARRAY') {
        return CORE::join($separator // '', @{$array});
    } else {
        JasPerl::JspTagException->throw("invalid type for 'join': $array");
    }
}

=item length( $input )

Returns the number of items in a collection, or the number of
characters in a string.

=cut

sub length {
    my ($class, $input) = @_;
    if (not defined $input) {
        return $ZERO;
    } elsif (exists $LENGTH{ref $input}) {
        return $LENGTH{ref $input}->($input);
    } elsif (eval { $input->isa('JasPerl::Util::Enumeration') }) {
        my $count = 0;
        while ($input->has_next) {
            $input->next();
            $count++;
        }
        return $count;
    } else {
        JasPerl::JspTagException->throw("invalid type for 'length': $input");
    }
}

=item replace( $str, $before, $after )

Returns a string resulting from replacing in an input string all
occurrences of a "before" substring into an "after" substring.

=cut

sub replace {
    my ($class, $string, $before, $after) = @_;
    return '' unless CORE::length($string);
    return $string unless CORE::length($before);

    if (CORE::length($after)) {
        $string =~ s/\Q$before\E/$after/g;
    } else {
        $string =~ s/\Q$before\E//g;
    }
    return $string;
}

=item split( $str, $delimiters )

Splits a string into an array of substrings.

=cut

sub split {
    my ($class, $string, $delimiters) = @_;
    return [ '' ] unless CORE::length($string);
    return [ $string ] unless CORE::length($delimiters);
    return [ split(/[\Q$delimiters\E]/, $string) ];
}

=item starts_with( $str, $prefix )

Tests if a string starts with the specified prefix.

=cut

sub starts_with {
    my ($class, $string, $prefix) = @_;
    return TRUE unless CORE::length($prefix);
    return FALSE unless CORE::length($string);
    return CORE::index($string, $prefix) == 0 ? TRUE : FALSE;
}

=item substring( $str, $begin, $end )

Returns a subset of a string.

=cut

sub substring {
    my ($class, $string, $begin, $end) = @_;
    my $strlen = CORE::length($string) or return '';

    my $offset = int($begin) >= 0 ? int($begin) : 0;
    return '' if $offset >= $strlen;

    my $length = (int($end) >= 0 ? int($end) : $strlen) - $offset;
    return '' if $length <= 0;

    return CORE::substr($string, $offset, $length);
}

=item substring_after( $str, $substr )

Returns a subset of a string following a specific substring.

=cut

sub substring_after {
    my ($class, $string, $substring) = @_;
    my $strlen = CORE::length($string) or return '';
    my $sublen = CORE::length($substring) or return $string;

    my $index = CORE::index($string, $substring);
    return '' if $index < 0;
    return CORE::substr($string, $index + $sublen);
}

=item substring_before( $str, $substr )

Returns a subset of a string before a specific substring.

=cut

sub substring_before {
    my ($class, $string, $substring) = @_;
    my $strlen = CORE::length($string) or return '';
    my $sublen = CORE::length($substring) or return '';

    my $index = CORE::index($string, $substring);
    return '' if $index < 0;
    return CORE::substr($string, 0, $index);
}

=item to_lower_case( $str )

Converts all of the characters of a string to lower case.

=cut

sub to_lower_case {
    my ($class, $string) = @_;
    return '' unless CORE::length($string);
    return lc $string;
}

=item to_upper_case( $str )

Converts all of the characters of a string to upper case.

=cut

sub to_upper_case {
    my ($class, $string) = @_;
    return '' unless CORE::length($string);
    return uc $string;
}

=item trim( $str )

Removes white space from both ends of a string.

=cut

sub trim {
    my ($class, $string) = @_;
    return '' unless CORE::length($string);
    # TODO: java.lang.String.trim removes characters <= \u0020
    $string =~ s/^\s+//s;
    $string =~ s/\s+$//s;
    return $string;
}

1;
